home *** CD-ROM | disk | FTP | other *** search
/ L' Effet Pommier 3 / L'Effet Pommier - Volume 03.iso / Graphismes / Bitmap / NIH Image 1.59 / Macros / Editing Macros < prev    next >
Text File  |  1995-06-27  |  7KB  |  293 lines
  1. var {Global variable, initially zero}
  2.   RoiLeft,RoiTop,RoiRight,RoiBottom:integer;
  3.  
  4. macro 'Show Tools [T]';
  5. begin
  6.   SelectWindow('Tools');
  7. end;
  8.  
  9. Macro 'Draw Arrow [A]'
  10. {Draws an arrow based on the current straight line selection.}
  11. var
  12.   size,angle,dx,dy,pi,theta:real;
  13.   x1,y1,x2,y2,LineWidth,width,height:integer;
  14. begin
  15.   size:=12;  {pixels}
  16.   angle:=20; {degrees}
  17.   pi:=3.14159;
  18.   GetLine(x1,y1,x2,y2,LineWidth);
  19.   if x1<0 then begin
  20.      beep;
  21.     PutMessage('Use the line tool (straight) to select a line first.');
  22.     exit;
  23.   end;
  24.   MoveTo(x1,y1);
  25.   LineTo(x2,y2);
  26.   KillRoi;
  27.   GetPicSize(width,height);
  28.   y1:=height-y1;
  29.   y2:=height-y2;
  30.   if LineWidth>1 then size:=size*LineWidth*0.5;
  31.   angle:=(angle/180)*pi;
  32.   dx:=x1-x2;
  33.   dy:=y1-y2;
  34.   if dx=0 then begin
  35.     if dy>=0 then theta:=pi/2 else theta:=3/2*pi
  36.   end else begin
  37.     theta:=arctan(dy/dx);
  38.     if dx<0 then theta:=theta+pi;
  39.   end;
  40.   moveto(x2,height-y2);
  41.   lineto(x2+size*cos(theta+angle),height-(y2+size*sin(theta+angle)));
  42.   moveto(x2,height-y2);
  43.   lineto(x2+size*cos(theta-angle),height-(y2+size*sin(theta-angle)));
  44. end;
  45.  
  46. macro 'Clear Outside [C]'
  47.  {Erase region outside current selection to background color.}
  48. begin
  49.   Copy;
  50.   SelectAll;
  51.   Clear;
  52.   RestoreRoi;
  53.   Paste;
  54.   KillRoi;
  55. end;
  56.  
  57. macro 'Change Colors';
  58. {
  59. Changes the value of pixels in the image that are in
  60. the current foreground color to the current background
  61. color. Use Undo if you don't like the result.
  62. }
  63. var
  64.   SavePixel,foreground,background:integer;
  65.  begin
  66.   SavePixel:=GetPixel(0,0);
  67.   MakeRoi(0,0,1,1);
  68.   Fill;
  69.   foreground:=GetPixel(0,0);
  70.   Clear;
  71.   background:=GetPixel(0,0);
  72.   PutPixel(0,0,SavePixel);
  73.   PutMessage('Pixels in the foreground color (',foreground:1,') will be changed to the background color (',background:1,').');
  74.   ChangeValues(foreground,foreground,background);
  75. end;
  76.  
  77. macro 'Change Values╔';
  78. var
  79.   v1,v2:integer;
  80. begin
  81.   v1:=GetNumber('Change pixels with this value:',255);
  82.   v2:=GetNumber('to this value:',254);
  83.   ChangeValues(v1,v1,v2);
  84. end;
  85.  
  86. macro 'Fix Pseudocolors';
  87. begin
  88.   ChangeValues(0,0,1);
  89.   ChangeValues(255,255,254);
  90. end;
  91.  
  92. macro 'Remove Isolated Black Lines';
  93. var
  94.   width,height,value,x,y,xstart,ystart:integer;
  95. begin
  96.   GetRoi(xstart,ystart,width,height);
  97.   if width=0 then begin
  98.     PutMessage('This macro requires a retangular selection');
  99.     exit;
  100.   end;
  101.   for y:=ystart to ystart+height-1 do begin
  102.     if GetPixel(width div 2,y)=255 then
  103.       for x:=xstart to xstart+width-1 do
  104.         PutPixel(x,y,(GetPixel(x,y-1)+GetPixel(x,y+1))/2);
  105.   end;
  106.   KillRoi;
  107. end;
  108.  
  109. macro 'Make Mosaic';
  110. var
  111.   n:integer;
  112. begin
  113.   SaveState;
  114.   n:=GetNumber('Cell Size(pixels square):',8);
  115.   Duplicate('Mosaic');
  116.   SetScaling('Nearest; Same Window');
  117.   ScaleSelection(1/n,1/n);
  118.   RestoreRoi;
  119.   ScaleSelection(n,n);
  120.   RestoreState;
  121. end;
  122.  
  123. macro 'Draw Grid╔';
  124. var
  125.   x,y,xinc,yinc,width,height:integer;
  126. begin
  127.   GetPicSize(width,height);
  128.   xinc:=GetNumber('Horizontal Spacing:',16);
  129.   yinc:=GetNumber('Vertical Spacing:',xinc);
  130.   x:=0;
  131.   y:=0;
  132.   repeat
  133.     x:=x+xinc;
  134.     y:=y+yinc;
  135.     moveto(0,y);
  136.     lineto(width,y);
  137.     moveto(x,0);
  138.     lineto(x,height);
  139.   until (x>width) and (y>height);
  140. end;
  141.  
  142. macro 'Make 256x256 Selection [S]';
  143. {Creates a 256x256 selection centered on the image.}
  144. var
  145.   w,h:integer;
  146. begin
  147.   GetPicSize(w,h);
  148.   MakeRoi((w-246)/2,(h-256)/2, 256, 256);
  149. end;
  150.  
  151.  
  152. macro 'Position fixed size ROI';
  153. var width,height,x,y:integer;
  154. begin
  155.   width:=100; height:=100;
  156.   repeat
  157.      GetMouse(x,y);
  158.      MakeRoi(x-width/2,y-height/2,width,height);
  159.      DrawBoundary;
  160.      Undo;
  161.   until button;
  162. end;
  163.  
  164. macro 'Flip ROI Horizontally';
  165. {
  166. Creates a "mirror image" of the current ROI.  It opens a temporary
  167. blank window, transfers the ROI to that window, draws its outline,
  168. flips the contents horizontally, creates a new marching ants ROI 
  169. using the AutoOutline command, restores the flipped ROI to the
  170. original window, and then deletes the temporary window.
  171. }
  172. var
  173.   hloc,vloc,width,height,pid1,pid2:integer;
  174. begin
  175.   RequiresVersion(1.55);
  176.   GetRoi(hloc,vloc,width,height);
  177.   if width=0 then begin
  178.     PutMessage('This macro requires a selection');
  179.     exit;
  180.   end;
  181.   SaveState;
  182.   MoveRoi(-hloc,-vloc);
  183.   KillRoi;
  184.   SetNewSize(width+1,height);
  185.   SetForegroundColor(255);
  186.   SetBackgroundColor(0);
  187.   pid1:=PidNumber;
  188.   MakeNewWindow('Temp');
  189.   RestoreRoi;
  190.   DrawBoundary;
  191.   SelectAll;
  192.   FlipHorizontal;
  193.   KillRoi;
  194.   AutoOutline(0,height/2);
  195.   pid2:=PidNumber;
  196.   SelectPic(pid1);
  197.   RestoreRoi;
  198.   SelectPic(pid2);
  199.   Dispose;
  200.   RestoreState;
  201. end;
  202.  
  203.  
  204. macro '(-' begin end;
  205.  
  206. macro 'Make Circle╔ [M]';
  207. var
  208.   x1,x2,y1,y2,top,left,width,height: integer;
  209.   xcenter, ycenter: integer;
  210.   d, scale, default: real;
  211.   unit, prompt: string;
  212. begin
  213.   GetLine(x1,y1,x2,y2,width);
  214.   if x1<0 then begin
  215.     PutMessage('Click with line selection tool to define center.');
  216.     exit;
  217.   end;
  218.   xcenter:=x1+(x2-x1)/2;
  219.   ycenter:=y1+(y2-y1)/2;
  220.   GetScale(scale, unit);
  221.   if unit='pixel' then unit:='pixels';
  222.   default:=50/scale;
  223.   prompt:=concat('Diameter (', unit:1:2, '):');
  224.   d:=GetNumber(prompt, default);
  225.   d:=d*scale;
  226.   MakeOvalROI(xcenter-d/2, ycenter-d/2, d, d);
  227. end;
  228.  
  229.  
  230. macro 'Make Circle from Line';
  231. var
  232.   x1,x2,y1,y2,top,left,width,height:integer;
  233.   xcenter,ycenter,radius:integer;
  234. begin
  235.   GetLine(x1,y1,x2,y2,width);
  236.   if x1<0 then begin
  237.     PutMessage('This macro requires a line selection.');
  238.     exit;
  239.   end;
  240.   xcenter:=x1+(x2-x1)/2;
  241.   ycenter:=y1+(y2-y1)/2;
  242.   radius:=sqrt(sqr(x2-x1)+sqr(y2-y1))/2;
  243.   MakeOvalROI(xcenter-radius,ycenter-radius,radius*2,radius*2);
  244. end;
  245.  
  246.  
  247. macro 'Define Upper Left [1]';
  248. var
  249.   x1,y1,x2,y2,LineWidth:integer;
  250. begin
  251.   GetLine(x1,y1,x2,y2,LineWidth);
  252.   if x1<0 then begin
  253.      PutMessage('Click with line selection tool to define upper left corner of ROI.');
  254.      exit;
  255.   end;
  256.   RoiLeft:=x1+(x2-x1)/2;
  257.   RoiTop:=y1+(y2-y1)/2;
  258. end;
  259.  
  260. macro 'Define Lower Right and Create ROI [2]';
  261. var
  262.   x1,y1,x2,y2,LineWidth:integer;
  263. begin
  264.   GetLine(x1,y1,x2,y2,LineWidth);
  265.   if x1<0 then begin
  266.      PutMessage('Click with line selection tool to define lower right corner of ROI.');
  267.      exit;
  268.   end;
  269.   RoiRight:=x1+(x2-x1)/2;
  270.   RoiBottom:=y1+(y2-y1)/2;
  271.   if (RoiLeft=RoiRight) and (RoiTop=RoiBottom) then begin
  272.     PutMessage('Upper left and bottom right are the same.');
  273.     exit;
  274.   end;
  275.   MakeRoi(RoiLeft,RoiTop,RoiRight-RoiLeft,RoiBottom-RoiTop)
  276. end;
  277.  
  278.  
  279. macro 'Draw File Name in each Image';
  280.  var
  281.    i: integer;
  282. begin
  283.   SaveState;
  284.   SetForegroundColor(255);
  285.   for i := 1 to nPics do begin
  286.      SelectPic(i);
  287.      MoveTo(10,12);
  288.      Write(WindowTitle);
  289.   end;
  290.   RestoreState;
  291. end;
  292.  
  293.